home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EXEC.SWG / 0022_Execute PKZIP.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  9KB  |  339 lines
  1. UNIT PKZExec;
  2.  
  3. INTERFACE
  4.  
  5. USES DOS;
  6.  
  7. { Purpose :  Execute PKZIP/PKUNZIP on archive files                         }
  8. { Uses specialized EXEC procedure so main program can use ALL of the memory }
  9. { Also shows how to take over INT29 to NOT display anything on the CRT      }
  10.  
  11. CONST
  12.     PKZIP             : PathStr = 'PKZIP.EXE';
  13.     PKUNZIP           : PathStr = 'PKUNZIP.EXE';
  14.  
  15. VAR ZIPError          : INTEGER;
  16.  
  17. PROCEDURE CleanUpDir (WorkDir, FileMask : STRING);
  18.                    {Erases files based on a mask }
  19.  
  20. PROCEDURE DisplayZIPError;
  21.                    { PKZip interface }
  22.  
  23. PROCEDURE DefaultCleanup (WorkDir : STRING);
  24.                    {Erases files *.BAK, *.MAP, temp*.*}
  25.  
  26. PROCEDURE ShowEraseStats;
  27.                    {shows count & bytes recovered}
  28.  
  29. FUNCTION  UnZIPFile (ZIPOpts, ZIPName, DPath, fspec : STRING; qt : BOOLEAN) : BOOLEAN;
  30.                    {Uses PKUnZip to de-archive files }
  31.  
  32. FUNCTION  ZIPFile (ZIPOpts, ZIPName, fspec  : STRING; qt : BOOLEAN) : BOOLEAN;
  33.                    {Uses PKZip to archive files }
  34.  
  35. IMPLEMENTATION
  36.  
  37. VAR  ZIPDefaultZIPOpts : STRING [16];
  38. VAR  ZIPFileName       : STRING [50];
  39. VAR  ZIPDPath          : STRING [50];
  40.  
  41. VAR  EraseCount        : WORD;        { files erased }
  42.      EraseSizeK        : LONGINT;     { kilobytes released by erasing files }
  43.      ShowOnWrite       : BOOLEAN;
  44.      I29H              : POINTER;
  45.  
  46. { EXECUTE STUFF - SHRINK HEAP AND EXECUTE LIKE EXECDOS }
  47.  
  48. {$F+}
  49. PROCEDURE Int29Handler (AX, BX, CX, DX, SI, DI, DS, ES, BP : WORD); INTERRUPT;
  50. VAR
  51.   Dummy : BYTE;
  52. BEGIN
  53.   Asm
  54.     Sti
  55.   END;
  56.   IF ShowOnWrite THEN WRITE (CHAR (LO (Ax) ) );
  57.   Asm
  58.     Cli
  59.   END;
  60. END;
  61.  
  62. PROCEDURE ReallocateMemory (P : POINTER); ASSEMBLER;
  63. ASM
  64.   MOV  AX, PrefixSeg
  65.   MOV  ES, AX
  66.   MOV  BX, WORD PTR P + 2
  67.   CMP  WORD PTR P, 0
  68.   JE   @OK
  69.   INC  BX
  70.  
  71.  @OK :
  72.   SUB  BX, AX
  73.   MOV  AH, 4Ah
  74.   INT  21h
  75.   JC   @X
  76.   LES  DI, P
  77.   MOV  WORD PTR HeapEnd, DI
  78.   MOV  WORD PTR HeapEnd + 2, ES
  79.  @X :
  80. END;
  81.  
  82. { ZAP this DEFINE if NOT 386,486}
  83. {..$DEFINE CPU386}
  84.  
  85. FUNCTION EXECUTE (Name : PathStr ; Tail : STRING) : WORD; ASSEMBLER;
  86. ASM
  87.   {$IFDEF CPU386}
  88.   DB      66h
  89.   PUSH    WORD PTR HeapEnd
  90.   DB      66h
  91.   PUSH    WORD PTR Name
  92.   DB      66h
  93.   PUSH    WORD PTR Tail
  94.   DB      66h
  95.   PUSH    WORD PTR HeapPtr
  96.   {$ELSE}
  97.   PUSH    WORD PTR HeapEnd + 2
  98.   PUSH    WORD PTR HeapEnd
  99.   PUSH    WORD PTR Name + 2
  100.   PUSH    WORD PTR Name
  101.   PUSH    WORD PTR Tail + 2
  102.   PUSH    WORD PTR Tail
  103.   PUSH    WORD PTR HeapPtr + 2
  104.   PUSH    WORD PTR HeapPtr
  105.   {$ENDIF}
  106.  
  107.   CALL ReallocateMemory
  108.   CALL SwapVectors
  109.   CALL DOS.EXEC
  110.   CALL SwapVectors
  111.   CALL ReallocateMemory
  112.   MOV  AX, DosError
  113.   OR   AX, AX
  114.   JNZ  @OUT
  115.   MOV  AH, 4Dh
  116.   INT  21h
  117.  @OUT :
  118. END;
  119. {$F-}
  120.  
  121. FUNCTION ExecuteCommand(p,s : STRING; quiet : BOOLEAN) : INTEGER;
  122. BEGIN
  123. ShowOnWrite := NOT quiet;  { turn off INT 29 }
  124. GETINTVEC ($29, I29H);
  125. SETINTVEC ($29, @Int29Handler);         { Install interrupt handler }
  126. Execute(p,s);
  127. SETINTVEC ($29, I29h);
  128. IF DosError = 0 THEN ExecuteCommand := DosExitCode   ELSE ExecuteCommand := DosError;
  129. END;
  130.  
  131. FUNCTION AddBackSlash (dName : STRING) : STRING;
  132. BEGIN
  133.   IF dName [LENGTH (dName) ] IN ['\', ':', #0] THEN
  134.     AddBackSlash := dName
  135.   ELSE
  136.     AddBackSlash := dName + '\';
  137. END;
  138.  
  139. FUNCTION EraseFile ( S : PathStr ) : BOOLEAN ;
  140.  
  141. VAR F : FILE;
  142.  
  143. BEGIN
  144.  
  145. EraseFile := FALSE;
  146.  
  147. ASSIGN (F, S);
  148. RESET (F);
  149.  
  150. IF IORESULT <> 0 THEN EXIT;
  151.  
  152.   CLOSE (F);
  153.   ERASE (F);
  154.   EraseFile := (IORESULT = 0);
  155.  
  156. END;
  157.  
  158. FUNCTION FileExists ( S : PathStr ) : BOOLEAN ;
  159.  
  160. VAR F : FILE;
  161.  
  162. BEGIN
  163.  
  164. FileExists := FALSE;
  165.  
  166. ASSIGN (F, S);
  167. RESET (F);
  168.  
  169. IF IORESULT <> 0 THEN EXIT;
  170.  
  171.   CLOSE (F);
  172.   FileExists := (IORESULT = 0);
  173.  
  174. END;
  175.  
  176. PROCEDURE CleanUpFile (WorkDir : STRING; SR : searchRec);
  177. VAR l    : LONGINT;
  178.     BEGIN
  179.     WITH SR DO
  180.         BEGIN
  181.         l := size DIV 512;
  182.         IF (attr AND 31) = 0 THEN
  183.             BEGIN
  184.             IF l = 0 THEN l := 1;
  185.             EraseSizeK := EraseSizeK + l;
  186.             WRITELN ('         Removing: ', (AddBackSlash (WorkDir) + name),
  187.                     '   ', l DIV 2, 'k');
  188.             EraseFile (AddBackSlash (WorkDir) + name);
  189.             INC (EraseCount);
  190.             END
  191.         ELSE WRITELN (' ??  ', (AddBackSlash (WorkDir) + name), '   ', l DIV 2, 'k',
  192.                      '  attr: ', attr);
  193.         END;
  194.     END;
  195.  
  196.  
  197. PROCEDURE CleanUpDir (WorkDir, FileMask : STRING);
  198. VAR Frec : SearchRec;
  199.     s    : STRING [64];
  200.     BEGIN
  201.     s := '';
  202.     FINDFIRST (AddBackSlash (WorkDir) + FileMask, anyfile, Frec);
  203.     WHILE doserror = 0 DO
  204.         BEGIN
  205.         CleanUpFile (WorkDir, Frec);
  206.         FINDNEXT (Frec);
  207.         END;
  208.     END;
  209.  
  210.  
  211. PROCEDURE DefaultCleanup (WorkDir : STRING);
  212.     BEGIN
  213.     CleanUpDir (WorkDir, '*.BAK');
  214.     CleanUpDir (WorkDir, '*.MAP');
  215.     CleanUpDir (WorkDir, 'TEMP*.*');
  216.     END;
  217.  
  218.  
  219. PROCEDURE DisplayZIPError;
  220.     BEGIN
  221.     CASE ziperror OF
  222.         0       : WRITELN ('no error');
  223.         2,3     : WRITELN (ziperror : 3, ' Error in ZIP file ');
  224.         4..8    : WRITELN (ziperror : 3, ' Insufficient Memory');
  225.         11,12   : WRITELN (ziperror : 3, ' No MORE files ');
  226.         9,13    : WRITELN (ziperror : 3, ' File NOT found ');
  227.         14,50   : WRITELN (ziperror : 3, ' Disk FULL !! ');
  228.         51      : WRITELN (ziperror : 3, ' Unexpected EOF in ZIP file ');
  229.         15      : WRITELN (ziperror : 3, ' Zip file is Read ONLY! ');
  230.         10,16   : WRITELN (ziperror : 3, ' Bad or illegal parameters ');
  231.         17      : WRITELN (ziperror : 3, ' Too many files ');
  232.         18      : WRITELN (ziperror : 3, ' Could NOT open file ');
  233.         1..90   : WRITELN (ziperror : 3, ' Exec DOS error ');
  234.         98      : WRITELN (ziperror : 3, ' requested file not produced ');
  235.         99      : WRITELN (ziperror : 3, ' archive file not found');
  236.         END;
  237.     END;
  238.  
  239.  
  240. PROCEDURE PKZIPInit;
  241.      BEGIN
  242.      PKZIP   := FSearch('PKZIP.EXE',GetEnv('PATH'));
  243.      PKUNZIP := FSearch('PKUNZIP.EXE',GetEnv('PATH'));
  244.      ZIPError          := 0;
  245.      ZIPDefaultZIPOpts := '-n';
  246.      ZIPFileName       := '';
  247.      ZIPDPath          := '';
  248.      EraseCount        := 0;
  249.      EraseSizeK        := 0;
  250.      END;
  251.  
  252.  
  253. PROCEDURE ShowEraseStats;
  254.     {-Show statistics at the end of run}
  255.     BEGIN
  256.     WRITELN ('Files Erased: ', EraseCount,
  257.             '  bytes used: ', EraseSizeK DIV 2, 'k');
  258.     END;
  259.  
  260.  
  261. FUNCTION  UnZIPFile ( ZIPOpts, ZIPName, DPath, fspec : STRING; qt : BOOLEAN) : BOOLEAN;
  262. VAR s, zname     : STRING;
  263.     i, j         : INTEGER;
  264.     BEGIN
  265.     ZIPError       := 0;
  266.     UnZIPFile := TRUE;
  267.     s := '';
  268.     IF ZIPOpts <> '' THEN  s := s + ZIPOpts
  269.     ELSE                   s := s + ZIPDefaultZIPOpts;
  270.  
  271.     IF ZIPName <> '' THEN  zname := ZIPName
  272.     ELSE                   zname := ZIPFileName;
  273.     IF NOT FileExists (zname) THEN
  274.         BEGIN
  275.         WRITELN ('zname: [', zname, ']');
  276.         UnZIPFile := FALSE;
  277.         ZIPError := 99;
  278.         EXIT;
  279.         END;
  280.  
  281.     s := s + ' ' + zname;
  282.  
  283.     IF DPath <> '' THEN s := s + ' ' + DPath
  284.     ELSE                   s := s + ' ' + ZIPDPath;
  285.     s := s + ' ' + fspec;
  286.     ZIPError := ExecuteCommand (PKUNZIP,s,qt);
  287.     IF ZIPError > 0 THEN
  288.          BEGIN
  289.          WRITELN ('PKUNZIP start failed ', ZIPError, ' [', s, ']');
  290.          UnZIPFile := FALSE;
  291.          END
  292.     ELSE BEGIN
  293.          i := POS ('*', fspec);
  294.          j := POS ('?', fspec);
  295.          IF (i = 0) AND (j = 0) THEN
  296.              BEGIN
  297.              IF NOT FileExists (DPath + fspec) THEN
  298.                   BEGIN
  299.                   UnZIPFile := FALSE;
  300.                   ZIPError := 98;
  301.                   END;
  302.              END;
  303.          END;
  304.     END;
  305.  
  306. FUNCTION  ZIPFile ( ZIPOpts, ZIPName, fspec  : STRING; qt : BOOLEAN) : BOOLEAN;
  307. VAR s, zname     : STRING;
  308.     i, j         : INTEGER;
  309.     BEGIN
  310.     ZIPError       := 0;
  311.     ZIPFile := TRUE;
  312.     s  := '';
  313.     IF ZIPOpts <> '' THEN  s := s + ZIPOpts
  314.     ELSE                   s := s + ZIPDefaultZIPOpts;
  315.  
  316.     IF ZIPName <> '' THEN  zname := ZIPName
  317.     ELSE                   zname := ZIPFileName;
  318.     s := s + ' ' + zname;
  319.     s := s + ' ' + fspec;
  320.     ZIPError := ExecuteCommand (PKZIP,s,qt);
  321.     IF ZIPError > 0 THEN
  322.          BEGIN
  323.          WRITELN ('PKZIP start failed ', ZIPError, ' [', s, ']');
  324.          ZIPFile := FALSE;
  325.          END
  326.     ELSE BEGIN
  327.          IF NOT FileExists (ZIPname + '.ZIP') THEN
  328.               BEGIN
  329.               ZIPFile := FALSE;
  330.               ZIPError := 98;
  331.               END;
  332.          END;
  333.     END;
  334.  
  335.  
  336.      BEGIN
  337.      PKZIPInit;
  338.      END.
  339.